Visualização de dados, documentos dinâmicos e aplicações com R

Thiago Pires | FGV

12 de fevereiro, 2019

Visualização de dados

Visualização de dados

“A visualização de dados consiste na representação gráfica de informações e dados. Usando elementos visuais, como diagramas, gráficos e mapas.”

www.tableau.com

Tipos de gráficos

Pacotes

Alguns pacotes para visualização de dados no R:

  • library(graphics)
  • library(ggplot2)
  • library(plotly)
  • library(DT)
  • library(crosstalk)
  • library(flexdashboard)
  • library(shiny)

Tipos de variáveis

Conhecer os tipos de variáveis é importante para saber que tipo de gráfico deve ser utilizado.

library(dplyr)
library(randomNames)
library(lubridate)

# conjunto de dados produzidos artificialmente

set.seed(1233)
dados <- tibble(Sexo = factor(rbinom(100, 1, .5), labels = c("Female", "Male")),
                Ano = runif(100, 1950, 2010) %>% trunc(),
                Nome = randomNames(gender = Sexo, ethnicity = "Hispanic", which.names = "first"),
                Idade = (year(Sys.Date()) - Ano) %>% trunc(),
                Doente = factor(rbinom(100, 1, .5), labels = c("Sim", "Não")))

dados %>% glimpse()
## Observations: 100
## Variables: 5
## $ Sexo   <fct> Male, Female, Female, Female, Female, Male, Female, Fem...
## $ Ano    <dbl> 2009, 1952, 1990, 1971, 1988, 1981, 1960, 1993, 1967, 1...
## $ Nome   <chr> "Agustin", "Evelyn", "Cynthia", "Letty", "Alyssa", "Ada...
## $ Idade  <dbl> 10, 67, 29, 48, 31, 38, 59, 26, 52, 24, 51, 35, 68, 30,...
## $ Doente <fct> Sim, Não, Sim, Não, Sim, Não, Não, Sim, Sim, Sim, Não, ...

library(graphics)

plot()

set.seed(10) # fixando a semente
x <- 1:10
y <- rnorm(10)

plot(x, y, col = "blue") # cores disponíveis em colours()

Cores

colours() %>% length()
## [1] 657
colours()[1:30]
##  [1] "white"          "aliceblue"      "antiquewhite"   "antiquewhite1" 
##  [5] "antiquewhite2"  "antiquewhite3"  "antiquewhite4"  "aquamarine"    
##  [9] "aquamarine1"    "aquamarine2"    "aquamarine3"    "aquamarine4"   
## [13] "azure"          "azure1"         "azure2"         "azure3"        
## [17] "azure4"         "beige"          "bisque"         "bisque1"       
## [21] "bisque2"        "bisque3"        "bisque4"        "black"         
## [25] "blanchedalmond" "blue"           "blue1"          "blue2"         
## [29] "blue3"          "blue4"

Uma lista de cores no formato hexadecimal poderá ser encontrado em https://www.w3schools.com/colors/colors_picker.asp

plot()

set.seed(10)
x <- 1:10
y <- rnorm(10)

plot(x, y, col = "blue", type = "l", xlab = "Tempo", ylab = "Taxa")

points()

set.seed(10)
x <- 1:10
y <- rnorm(10)
z <- rnorm(10)

plot(x, y, col = "blue", type = "l", xlab = "Tempo", ylab = "Taxa")
points(x, z, col = "red", type = "b") # adicionando uma série de dados

ylim

set.seed(10)
x <- 1:10
y <- rnorm(10)
z <- rnorm(10)

plot(x, y, col = "blue", type = "l", xlab = "Tempo", ylab = "Taxa", 
     ylim = range(c(y, z))) # definindo os limites do eixo y
points(x, z, col = "red", type = "b")

types

set.seed(34)

par(mfrow = c(2, 2))
plot(rnorm(10), type = "l", main = "type = 'l'")
plot(rnorm(10), type = "p", main = "type = 'p'")
plot(rnorm(10), type = "b", main = "type = 'b'")
plot(rnorm(10), type = "s", main = "type = 's'")

lty

set.seed(34)

plot(runif(10), type = "l", lty = 1, ylim = c(0, 1)) # variando o lty de 1 à 4
points(runif(10), type = "l", lty = 2, col = "red")
points(runif(10), type = "l", lty = 3, col = "blue")
points(runif(10), type = "l", lty = 4, col = "tomato")
legend(8, 1, c("lty = 1", "lty = 2", "lty = 3", "lty = 4"), lty = 1:4, # inserindo legenda
       col = c("black", "red", "blue", "tomato"))

pch e grid()

set.seed(34)

plot(runif(10), type = "b", col = "blue", pch = 19, # inserindo pch diferentes
     panel.first = {grid(lty = 1)}, ylim = c(0, 1)) # inserindo grid()
points(runif(10), type = "b", col = "red", pch = 17)
legend(7.9, 1, c("pch = 19", "pch = 17"), 
       col = c("blue", "red"), pch = c(19, 17))

lwd

set.seed(34)

plot(runif(10), type = "l", col = "blue", lwd = 2,
     panel.first = {grid(lty = 1)}, ylim = c(0, 1))
points(runif(10), type = "b", col = "red", lwd = 4)
legend(7.8, 1, c("lwd = 2", "lwd = 4"), 
       col = c("blue", "red"), lwd = c(2, 4))

curve()

f <- function(x) (x - 3)*(x - 2)

curve(f, -2, 4, col = "blue")

curve(axes = FALSE)

f <- function(x) (x - 3)*(x - 2)

curve(f, -2, 4, col = "blue", axes = FALSE)
axis(1, pos = 0)
axis(2, las = 1, pos = 0, at = c(-Inf, seq(5, 20, 5)))

points(c(2, 3), c(0, 0), col = "blue", pch = 19)

curve(add = TRUE)

f <- function(x) exp(x)
g <- function(x) -x^2 + 10

curve(f, -4, 3, col = "blue", axes = FALSE, lwd = 3, 
      panel.first = {grid(lty = 1)}, ylab = "y")
curve(g, col = "tomato", add = TRUE, lwd = 3)
axis(1, pos = 0)
axis(2, las = 1, pos = 0, at = c(-Inf, seq(5, 20, 5)))
legend(-4, 20, c("f", "g"), col = c("blue", "tomato"), lwd = 3)

abline

f <- function(x) 10 + 1/x

curve(f, -1, 1, col = "blue", axes = FALSE, lwd = 3)
axis(1, pos = 0, at = c(-1, -.5, .5, 1))
axis(2, las = 1, pos = 0)

abline(h = 10, lty = 2, col = "tomato", lwd = 3) # adicionando uma linha vertical

hist()

set.seed(35)
x <- rnorm(100)

hist(x, main = "Histograma", col = "red", border = FALSE)

pie()

x <- c(21, 62, 10, 53)
labels <- c("London", "New York", "Singapore", "Mumbai")

pie(x, labels, border = FALSE)

Exercícios

  • Mostre a relação entre Time e demand utilizando a base de dados BOD.

  • Faça um gráfico utilizando as funções sin (seno) e cos (cosseno) onde o domínio de \(x\) é: \(-5 \leq x \leq 5\).

  • Faça um histograma com os dados do banco de dados WWWusage.

library(ggplot2)

Titanic

library(titanic)

titanic_train %>% 
  glimpse() # informações sobre o banco de dados
## Observations: 891
## Variables: 12
## $ PassengerId <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,...
## $ Survived    <int> 0, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 0,...
## $ Pclass      <int> 3, 1, 3, 1, 3, 3, 1, 3, 3, 2, 3, 1, 3, 3, 3, 2, 3,...
## $ Name        <chr> "Braund, Mr. Owen Harris", "Cumings, Mrs. John Bra...
## $ Sex         <chr> "male", "female", "female", "female", "male", "mal...
## $ Age         <dbl> 22, 38, 26, 35, 35, NA, 54, 2, 27, 14, 4, 58, 20, ...
## $ SibSp       <int> 1, 1, 0, 1, 0, 0, 0, 3, 0, 1, 1, 0, 0, 1, 0, 0, 4,...
## $ Parch       <int> 0, 0, 0, 0, 0, 0, 0, 1, 2, 0, 1, 0, 0, 5, 0, 0, 1,...
## $ Ticket      <chr> "A/5 21171", "PC 17599", "STON/O2. 3101282", "1138...
## $ Fare        <dbl> 7.2500, 71.2833, 7.9250, 53.1000, 8.0500, 8.4583, ...
## $ Cabin       <chr> "", "C85", "", "C123", "", "", "E46", "", "", "", ...
## $ Embarked    <chr> "S", "C", "S", "S", "S", "Q", "S", "S", "S", "C", ...

ggplot() + geom_bar()

library(ggplot2)

titanic_train %>% 
  ggplot(aes(Survived)) + geom_bar()

ggplot() + geom_bar()

titanic_train %>% 
  ggplot(aes(as.factor(Survived), 
             (..count../sum(..count..)))) + # neste argumento se calcula a proporção
  geom_bar() +
  scale_x_discrete(labels = c("Não", "Sim")) + # define as categorias no eixo x
  scale_y_continuous(labels = scales::percent) + # apresenta o eixo y em percentual
  labs(x = "Sobrevivente", y = "Percentual") # rótulo dos eixos x e y

ggplot() + geom_bar()

titanic_train %>% 
  ggplot(aes(as.factor(Survived), (..count../sum(..count..)))) + 
  geom_bar(fill = "#b30000", alpha = .6) + # altera a cor e opacidade
  scale_x_discrete(labels = c("Não", "Sim")) +
  scale_y_continuous(labels = scales::percent) +
  labs(x = "Sobrevivente", y = "Percentual") +
  theme_minimal() # mudança de tema

ggplot() + geom_bar()

titanic_train %>% 
  ggplot(aes(as.factor(Survived), (..count../sum(..count..)),
             fill = Sex)) + # preenchimento da barra segundo sexo
  geom_bar(alpha = .8, position = "fill") + # position = "fill" a barra é empilhada preenchendo 100%
  scale_x_discrete(labels = c("Não", "Sim")) +
  scale_y_continuous(labels = scales::percent) +
  labs(x = "Sobrevivente", y = "Percentual", fill = "Sexo") + # o argumento 'fill' altera o título da legenda
  theme_minimal()

scale_fill_manual()

titanic_train %>% 
  ggplot(aes(as.factor(Survived), (..count../sum(..count..)),
             fill = Sex)) + # preenchimento da barra segundo sexo
  geom_bar(alpha = .8, position = "fill") + # position = "fill" a barra é empilhada preenchendo 100%
  scale_x_discrete(labels = c("Não", "Sim")) +
  scale_y_continuous(labels = scales::percent) +
  scale_fill_manual("Sexo", values = c("female" = "black", "male" = "orange")) + # alterar as cores
  labs(x = "Sobrevivente", y = "Percentual") + # o argumento 'fill' altera o título da legenda
  theme_minimal()

ggplot() + geom_bar() + facet_grid()

titanic_train %>% 
  ggplot(aes(as.factor(Survived), (..count../sum(..count..)),
             fill = Sex)) +
  geom_bar(alpha = .8, position = "fill") + 
  facet_grid(~ Pclass) + # introdução de uma terceira variável na análise
  scale_x_discrete(labels = c("Não", "Sim")) +
  scale_y_continuous(labels = scales::percent) +
  scale_fill_manual("Sexo", values = c("female" = "black", "male" = "orange")) + # alterar as cores
  labs(x = "Sobrevivente", y = "Percentual", fill = "Sexo") +
  theme_light() # seleção de um outro tema

ggplot() + geom_boxplot()

titanic_train %>% 
  ggplot(aes(y = Age)) + geom_boxplot() # é necessário definir o y

ggplot() + geom_boxplot()

titanic_train %>% 
  ggplot(aes(as.factor(Survived), Age)) + geom_boxplot() + # distribuição da variável y segundo a variável x
  scale_x_discrete(labels = c("Não", "Sim")) +
  labs(x = "Sobrevivente", y = "Idade")

ggplot() + geom_boxplot()

titanic_train %>% 
  ggplot(aes(as.factor(Survived), Age, fill = Sex)) + geom_boxplot() +
  scale_x_discrete(labels = c("Não", "Sim")) +
  labs(x = "Sobrevivente", y = "Idade", fill = "Sexo")

ggplot() + geom_boxplot() + facet_grid()

titanic_train %>% 
  ggplot(aes(as.factor(Survived), Age)) + geom_boxplot() +
  facet_grid(. ~ Sex) +
  scale_x_discrete(labels = c("Não", "Sim")) +
  labs(x = "Sobrevivente", y = "Idade")

ggplot() + geom_boxplot() + facet_grid()

titanic_train %>% 
  ggplot(aes(as.factor(Survived), Age, fill = Sex)) + geom_boxplot() +
  facet_grid(. ~ Pclass) +
  scale_x_discrete(labels = c("Não", "Sim")) +
  labs(x = "Sobrevivente", y = "Idade", fill = "Sexo")

ggplot() + geom_line()

dengue$interest_over_time %>% 
  ggplot(aes(date, hits)) + geom_line()

ggplot() + geom_line()

times$interest_over_time %>% 
  ggplot(aes(date, hits, colour = keyword)) + geom_line()

ggplot() + geom_line()

(g1 <- times$interest_over_time %>% 
  mutate(semanas = week(date)) %>% # criando a variável semana
  group_by(semanas, keyword) %>% # agregando segundo semanas e times
  summarise(hits = mean(hits)) %>% # agregando com a média
  ggplot(aes(semanas, hits, colour = keyword)) + geom_line() +
  labs(x = "Semanas", y = "Hits"))

geom_rect() + geom_text()

g1 + geom_rect(aes(xmin = week("2018-06-14"), # início do período
                   xmax = week("2018-07-15"), # fim do período
                   ymin = -Inf, ymax = Inf), 
               fill = "#b3ff99", colour = "#ffffff", alpha = .006) +
  geom_text(aes(26, 20, label = "Copa do mundo"), # texto inserido
            angle = 90, show_guide  = FALSE) 

geom_text()

titanic_train %>% 
  group_by(Survived) %>% 
  summarise(n = n()) %>% 
  mutate(perc = n/sum(n) * 100) %>% 
  ggplot(aes(x = as.factor(Survived), y = perc)) + geom_col() +
  geom_text(aes(label = perc %>% round(1)), 
            vjust = 1.5, color = "white", size = 10) # vjust altera a posição vertical do texto

Exercícios

  • Gráfico de linhas relacionando faixa etária e taxa de mortalidade do banco VADeaths. (Dica: utilize VADeaths %>% reshape2::melt()).

  • Gráfico de barras utilizando o banco titanic::titanic_train com a variável Embarked.

  • Usar o mesmo banco anterior analisando o número de sobreviventes segundo o porto de embarcação.

  • Analisar com o google trends (gtrendsR) como o termo Lula se distribui de 01-01-2018 à 31-08-2018. Os picos descrevem eventos importantes?

library(wordcloud)

Núvem de palavras

A nuvem de palavras é uma técnica que permite realçar as palavras usadas com mais frequência em um texto.

wordcloud()

library(wordcloud)
library(gtrendsR)
library(magrittr)
library(RColorBrewer)

dengue <- gtrends("dengue", geo = "BR", time = "2018-01-01 2018-12-15")
related <- dengue$related_queries %>% 
  filter(related_queries == "top") %>% 
  select(subject, value) %>% 
  mutate(value = iconv(value, from = "utf-8", to = "iso8859-1"))

wordcloud()

wordcloud(words = related %>% pull(value), freq = related %>% pull(subject) %>% as.numeric,
          colors = brewer.pal(6, "Dark2"), random.order = FALSE)

library(plotly)

ggplotly()

library(plotly)
library(glue)

g2 <- titanic_train %>% 
  group_by(Survived, Sex) %>% summarise(n = n()) %>% 
  group_by(Survived) %>% mutate(perc = n/sum(n)) %>%
  ggplot(aes(as.factor(Survived), weight = perc, fill = Sex, 
             text = glue("{Sex} <br> {(perc * 100) %>% round(2)}%"))) + 
  geom_bar(alpha = .6, position = "fill") +
  scale_x_discrete(labels = c("Não", "Sim")) +
  scale_y_continuous(labels = scales::percent) +
  labs(x = "Sobrevivente", y = "Percentual", fill = "") + theme_minimal()

ggplotly(g2, tooltip = "text") %>% config(displayModeBar = FALSE) %>% layout(hovermode = TRUE)

plot_ly()

titanic_train %>% 
  plot_ly(x = ~factor(Survived, labels = c("Não", "Sim"))) %>% 
  layout(xaxis = list(title = "Sobrevivente"))

plot_ly()

titanic_train %>% 
  group_by(Survived) %>% 
  summarise(n = n()) %>% 
  mutate(perc = n/sum(n) * 100) %>% 
  plot_ly(x = ~factor(Survived, labels = c("Não", "Sim")), y = ~perc) %>% 
  layout(xaxis = list(title = "Sobrevivente"),
         yaxis = list(title = "%"))

plot_ly()

titanic_train %>% 
  group_by(Survived, Sex) %>% summarise(n = n()) %>% 
  group_by(Survived) %>% mutate(perc = (n/sum(n) * 100) %>% round(2)) %>% 
  plot_ly(x = ~factor(Survived, labels = c("Não", "Sim")), 
          y = ~perc, color = ~Sex) %>% 
  layout(xaxis = list(title = "Sobrevivente"),
         yaxis = list(title = "%"))

plot_ly()

titanic_train %>% 
  group_by(Survived, Sex) %>% summarise(n = n()) %>% 
  group_by(Survived) %>% mutate(perc = (n/sum(n) * 100) %>% round(2)) %>% 
  plot_ly(x = ~factor(Survived, labels = c("Não", "Sim")), 
          y = ~perc, color = ~Sex, opacity = .75,
          text = ~perc, textposition = "outside", # inserindo rótulo (auto/outside)
          colors = c("#47476b", "#a3a3c2")) %>% # alterando cores
  layout(xaxis = list(title = "Sobrevivente"),
         yaxis = list(title = "%"))

plot_ly()

titanic_train %>% 
  group_by(Survived, Sex) %>% summarise(n = n()) %>% 
  group_by(Survived) %>% mutate(perc = (n/sum(n) * 100) %>% round(2)) %>% 
  plot_ly(x = ~factor(Survived, labels = c("Não", "Sim")), 
          y = ~perc, color = ~Sex) %>% 
  layout(xaxis = list(title = "Sobrevivente"),
         yaxis = list(title = "%"),
         barmode = "stack") %>% # barras empilhadas
  config(displayModeBar = FALSE)

plot_ly(type = pie)

titanic_train %>% 
  group_by(Survived) %>% 
  summarise(n = n()) %>% 
  mutate(perc = n/sum(n) * 100) %>% 
  plot_ly(labels = ~factor(Survived, labels = c("Não sobreviveu", "Sobreviveu")), 
          values = ~perc, type = "pie", # gráfico de setores
          textinfo = "percent",
          hoverinfo = "percent+label") %>%
  layout(showlegend = T, font = list(size = 14)) # mostrar legenda e alterar tamanho da fonte

Instituto de Segurança Pública

read.csv2("data/BaseEstadoTaxaMes.csv") %>% # lendo arquivo .csv
  select(1:15) %>% 
  glimpse()
## Observations: 191
## Variables: 15
## $ vano                    <int> 2003, 2003, 2003, 2003, 2003, 2003, 20...
## $ mes                     <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,...
## $ hom_doloso              <dbl> 4.01, 3.97, 4.17, 3.98, 4.08, 3.72, 3....
## $ lesao_corp_morte        <dbl> 0.04, 0.03, 0.03, 0.07, 0.04, 0.01, 0....
## $ latrocinio              <dbl> 0.14, 0.08, 0.11, 0.10, 0.14, 0.10, 0....
## $ hom_por_interv_policial <dbl> 0.61, 0.76, 0.77, 0.85, 0.65, 0.59, 0....
## $ tentat_hom              <dbl> 2.48, 2.46, 2.26, 2.02, 2.59, 2.15, 2....
## $ lesao_corp_dolosa       <dbl> 46.94, 48.32, 47.43, 43.84, 39.77, 42....
## $ estupro                 <dbl> 1.67, 1.50, 1.61, 1.46, 1.29, 1.35, 1....
## $ hom_culposo             <dbl> 1.11, 1.28, 1.28, 1.41, 1.55, 1.61, 1....
## $ lesao_corp_culposa      <dbl> 21.08, 21.83, 20.37, 20.98, 22.34, 22....
## $ roubo_comercio          <dbl> 4.01, 4.90, 4.36, 4.78, 4.85, 4.38, 5....
## $ roubo_residencia        <dbl> 1.17, 1.16, 1.21, 1.15, 1.28, 0.95, 1....
## $ roubo_veiculo           <dbl> 95.87, 93.49, 85.99, 87.00, 92.62, 78....
## $ roubo_carga             <dbl> 2.43, 3.02, 2.11, 2.06, 2.35, 2.12, 2....

plot_ly(mode = line)

read.csv2("data/BaseEstadoTaxaMes.csv") %>% 
  mutate(date = glue("{vano}-{mes}") %>% ymd(truncated = 1)) %>% 
  select(date, hom_doloso) %>%
  plot_ly(x = ~date, y = ~hom_doloso, mode = "line+markers") %>% # gráfico de linha
  layout(title = "Taxa de homicídio doloso no estado do RJ", 
         xaxis = list(title = "Data"),
         yaxis = list(title = "Taxa por 100 mil hab.")) %>% 
  rangeslider() # controlar janela de visualização

add_trace()

read.csv2("data/BaseEstadoTaxaMes.csv") %>% 
  mutate(date = glue("{vano}-{mes}") %>% ymd(truncated = 1)) %>% # criando variável data com ano e mês
  select(date, hom_doloso, hom_culposo) %>%
  plot_ly(x = ~date) %>% 
  add_trace(y = ~hom_doloso, name = "Doloso", mode = "lines") %>% # adicionando série
  add_trace(y = ~hom_culposo, name = "Culposo", mode = "lines") %>% # adicionando série
  layout(title = "Taxa de homicídio no estado do RJ", 
         xaxis = list(title = "Data"), yaxis = list(title = "Taxa por 100 mil hab."), 
         hovermode = TRUE) %>% 
  config(displayModeBar = FALSE) %>% rangeslider()

plot_ly(type = box)

read.csv2("data/BaseEstadoTaxaMes.csv") %>% 
  select(vano, mes, roubo_veiculo) %>% 
  plot_ly(x = ~vano, y = ~roubo_veiculo, type = "box") %>% 
  layout(title = "Taxa de roubo de veículos no estado do RJ", 
         xaxis = list(title = "Ano"), yaxis = list(title = "Taxa por 100 mil hab."))

heatmap

matrix(AirPassengers, 12, 12, byrow = TRUE) %>% 
  plot_ly(x = month.abb, y = 1949:1960, 
          z = ., type = "heatmap") %>% 
  config(displayModeBar = FALSE)

Exercícios

  • Calcular o percentual das pessoas que embarcaram no Titanic segundo cada porto. Usar gráfico de setores para apresentar os resultados.

  • Mostrar a distribuição de idade comparando os sobreviventes e os que morreram no naufrágio do titanic. Usar boxplots para apresentar os reultados.

Exercícios

  • Seja a matriz produzida com o código abaixo com dados de temperatura (F) segundo dias e meses. Produza um heatmap com estas informações.
require(reshape2)
require(dplyr)

airquality %>% 
  melt(id = c("month", "day"), na.rm = TRUE) %>% 
  filter(variable == "temp") %>% 
  acast(day ~ month)

Use o heatmap.

library(DT)

datatable()

library(DT)

titanic_train %>% 
  select(Survived:Name) %>% 
  datatable(extensions = c("Scroller"), # aplicando barra de rolagem
            rownames = FALSE,
            options = list(deferRender = TRUE, # definindo as opções da barra de rolagem
                           scrollY = 200, # tamanho da janela
                           scroller = TRUE))

datatable()

titanic_train %>% 
  group_by(Survived) %>% 
  summarise(n = n()) %>% 
  mutate(perc = n/sum(n) * 100,
         Survived = factor(Survived, labels = c("Não", "Sim"))) %>% 
  datatable(colnames = c("Sobreviveu", "n", "%"), rownames = FALSE, 
            options = list(dom = "t")) %>% # a opção dom = "t" define a tabela sem busca e seleção de páginas
  formatRound(columns = "perc", digits = 2) # arredondamento de colunas selecionadas

library(crosstalk)

Países do mundo

library(readxl)

countries <- read_xlsx("data/countries of the world.xlsx")

countries %>% glimpse()
## Observations: 227
## Variables: 20
## $ Country                              <chr> "Afghanistan", "Albania",...
## $ Region                               <chr> "ASIA (EX. NEAR EAST)", "...
## $ Population                           <dbl> 31056997, 3581655, 329300...
## $ `Area (sq. mi.)`                     <dbl> 647500, 28748, 2381740, 1...
## $ `Pop. Density (per sq. mi.)`         <dbl> 48.0, 124.6, 13.8, 290.4,...
## $ `Coastline (coast/area ratio)`       <dbl> 0.00, 1.26, 0.04, 58.29, ...
## $ `Net migration`                      <dbl> 23.06, -4.93, -0.39, -20....
## $ `Infant mortality (per 1000 births)` <dbl> 163.07, 21.52, 31.00, 9.2...
## $ `GDP ($ per capita)`                 <dbl> 700, 4500, 6000, 8000, 19...
## $ `Literacy (%)`                       <dbl> 36.0, 86.5, 70.0, 97.0, 1...
## $ `Phones (per 1000)`                  <dbl> 3.2, 71.2, 78.1, 259.5, 4...
## $ `Arable (%)`                         <dbl> 12.13, 21.09, 3.22, 10.00...
## $ `Crops (%)`                          <dbl> 0.22, 4.42, 0.25, 15.00, ...
## $ `Other (%)`                          <dbl> 87.65, 74.49, 96.53, 75.0...
## $ Climate                              <dbl> 1.0, 3.0, 1.0, 2.0, 3.0, ...
## $ Birthrate                            <dbl> 46.60, 15.11, 17.14, 22.4...
## $ Deathrate                            <dbl> 20.34, 5.22, 4.61, 3.27, ...
## $ Agriculture                          <dbl> 0.380, 0.232, 0.101, NA, ...
## $ Industry                             <dbl> 0.240, 0.188, 0.600, NA, ...
## $ Service                              <dbl> 0.380, 0.579, 0.298, NA, ...

Fonte: https://www.kaggle.com/fernandol/countries-of-the-world

crosstalk

crosstalk

Dados submetidos para análise

sd <- 
  SharedData$new(countries %>% select(Country, Region, `Literacy (%)`, 
                                      `Infant mortality (per 1000 births)`))

Definição do gráfico

p1 <- sd %>% 
  plot_ly(x = ~`Literacy (%)`, y = ~`Infant mortality (per 1000 births)`, 
          text = ~Country,
          color = ~Region, mode = "markers") %>% 
  layout(xaxis = list(title = "Literacy (%)"),
         yaxis = list(title = "Infant mortality (per 1000 births)")) %>% 
  config(displayModeBar = FALSE)

crosstalk

Definição da tabela

dt1 <- sd %>% 
  datatable(colnames = c("Country", "Region", "Literacy", "Infant mortality"), 
            rownames = FALSE, filter = "top",
            options = list(dom = "t", deferRender = TRUE, scrollY = 100, scroller = TRUE,
                           columnDefs = list(list(targets = c(2, 3), searchable = FALSE))))

Layout e geração da saída

bscols(list(p1, dt1)) # usando list() coloca os outputs em coluna

Documentos dinâmicos e aplicações

R Markdown

O R possuí um módulo para a criação de documentos (apresentações, relatórios e dashboards), no qual é possível incorporar códigos em R (e outras linguagem) em documentos no formato Markdown, que poderá ser convertido em .html, .pdf ou .doc. Abaixo como mostra a figura, clicando em R Markdown aparecerá as opções para a criação de documentos.

Opções de documento

Em seguida aparece as opções do documento

Escrevendo em Markdown

Formatação de texto

Itálico:  *texto* ou _texto_
Negrito: **texto** ou texto   
Sobrescrito: texto^sobrescrito^
Subscrito: texto~subscrito~
Tachado: ~~texto~~
Títulos e Subtítulos

Título Nível 1:  # Título
Título Nível 2:  ## Título
Título Nível 3:  ### Título
Título Nível 4:  #### Título
Título Nível 5:  ##### Título
Título Nível 6:  ###### Título
Equações

Equação na mesma linha  do texto:  $A = \pi*r^2$
Equação na linha seguinte:  $$A = \pi*r^2$$
Links e Imagens

Links: [link](www.rstudio.com)
Imagens: ![caption_da_imagem](caminho/da/imagem.png)

Listas em Markdown

Ordenadas:

1.  item 1
2.  item 2
-   subitem 1
-   subitem 2

Não-ordenadas:

*   item 1
*   item 2
+ subitem 1
+ subitem 2

Tabelas em Markdown

Tabela:

Coluna 1    | Coluna 2
--------- | --------
Célula 1    | Célula 2
Célula 3    | Célula 4

Tabela com colunas alinhadas:

à esquerda |    centro  | à direita
:--------- | :-----:    | --------:
Célula 1    | Célula 2 | Célula 3
Célula 4    | Célula 5 | Célula 6

Mesclando texto com código

Para criar um chunk, use ```{r} e finalize-o com ```. No caso em que utiliza-se ```{r}, tanto o código, quanto o resultado são apresentados no documento. Quando declara-se ```{r echo=FALSE} o código é omitido.

  • eval determina quais linhas devem ser executadas (default: TRUE são todas)
```{r, eval=TRUE}
data(cars)
summary(cars)
```
```{r, eval=c(1, 3)}
data(cars)
summary(cars)
plot(cars)
```

Mesclando texto com código

  • fig.height e fig.width determinam as dimensões da figura
  • warnings determina se warnings devem ser mostrados (default: TRUE)
  • message determina se mensagens devem ser mostradas (default: TRUE)

Outras opções poderão ser encontradas aqui.

Preâmbulo do documento

Define algumas informações e configurações do documento a ser compilado.

---
title: "Untitled"
author: "Thiago"
date: "3 de janeiro de 2019"
output: html_document
---

Uma lista de formatos e configurações poderão ser consultadas aqui.

Projeto

  • relatório html (Titanic)

library(flexdashboard)

flexdashboard

O Flexdashboard poderá ser iniciado em: File > New File > R Markdown > From Template

Configurações de layout

---
title: "Untitled"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
---

Column {data-width=650}
-----------------------------------------------------------------------

### Chart A

```{r}

```

Column {data-width=350}
-----------------------------------------------------------------------

### Chart B

```{r}

```

### Chart C

```{r}

```

Configurações de layout


Para criação de um novo quadro

-------------------

Para criação de uma nova página

===================

Para criação de uma barra lateral

Sidebar {.sidebar}
-------------------

Para criação de guias

Tabset {.tabset}
-------------------

Outras configurações poderão ser vistas aqui.

Exercício

  • Criar um dashboard com algumas análises

Projeto

  • dashboard (Titanic)

library(shiny)

shiny

Shiny é uma ferramenta desenvolvida pelo RStudio que permite a criação de web aplicações interativas, sem conhecimento prévio de outras linguagens comumente utilizadas na criação de páginas na internet ou aplicativos como, por exemplo, HTML, CSS ou JavaScript. Um tutorial poderá ser acompanhado aqui.

Estrutura

Dois componentes que acompanham a aplicação são:

  • ui: responsável por controlar a aparência da aplicação
  • server: controla todo o processo de funcionamento

Para criar uma nova aplicação shiny deverá ir em: File > New File > Shiny Web App.

Estrutura

Na criação da aplicação existe a opção de trabalhar com um ou multiplos scripts (ui e server separados).

ui

library(shiny)

# ui
ui <- fluidPage(
   titlePanel("Old Faithful Geyser Data"), # título
   
   sidebarLayout( # sidebar
      sidebarPanel(
         sliderInput("bins",
                     "Number of bins:",
                     min = 1,
                     max = 50,
                     value = 30)
      ),
      
      mainPanel( # histograma
         plotOutput("distPlot")
      )))

server

# server
server <- function(input, output) {
   output$distPlot <- renderPlot({
      # gera bins baseado no input no ui
      x    <- faithful[, 2] 
      bins <- seq(min(x), max(x), length.out = input$bins + 1)
      
      hist(x, breaks = bins, col = 'darkgray', border = 'white')
   })
}

shinyApp(ui = ui, server = server)

Inputs

# checkbox
  checkboxInput(inputId = "checkbox", 
                label = "Única opção:", 
                value = TRUE)

# checkboxGroupInput
  checkboxGroupInput(inputId = "checkbox_multiplas", 
                     label = "Várias opções:",
                     choices = c("opção1", "opção2", "opção3"), 
                     selected = c("opção2", "opção3"))
                     
# dateInput
  dateInput(inputId = "data", 
            label = "Selecione uma data:", 
            min = "1900-01-01", 
            max = "2017-12-12")
            
# textInput
textInput(inputId = "texto", 
          label = "Olá! Tudo bem?", 
          value = "Sim")
          
# numericInput
numericInput(inputId = "numero", 
             label = "Escolha um número de 0 a 10:", 
             value = 3, 
             step = 0.5, 
             min = 0, 
             max = 10)

Inputs

# passwordInput
passwordInput(inputId = "senha", 
              label = "Digite sua senha")

# selectInput
selectInput(inputId = "lista1", 
            label = "Selecione um item nessa lista", 
            choices = c("Item 1", "Item 2", "Item 3"),  
            multiple = F)

# mais um selectInput
selectInput(inputId = "lista2", 
            label = "Selecione um item ou mais nessa lista", 
            choices = c("Item 1", "Item 2", "Item 3"), 
            multiple = T, 
            selectize = F)

# sliderInput
sliderInput(inputId = "slider", 
            label = "Selecione um número", 
            min = 0, 
            max = 100, 
            step = 0.01, 
            value = 50)

Outputs

Após você capturar informações via inputs, você poderá manipular essas informações no server e produzir resultados que serão apresentados no ui. Para criar um output você precisa utilizar a sintaxe output$nome_output e uma função de renderização de objetos. Veja a seguir alguns exemplos de funções de renderização.

Outputs

  • renderPlot(): cria um output de um plot do R. Deve ser usada em conjunto com a função plotOutput().
  • renderPlotly(): cria um output para gráficos do pacote plotly. Deve ser usada em conjunto com a função plotlyOutput().
  • renderDygraph(): cria um output para gráficos do pacote dygraphs. Deve ser usada em conjunto com a função dygraphOutput().
  • renderPrint(): cria um output para as saídas que são mostradas no console do R.

Outputs

  • renderTable(): cria um output em formato de tabela. Você pode usar essa função, por exemplo, para mostrar data.frame’s ou matrizes. Deve ser usada em conjunto com a função tableOutput().
  • renderText(): cria um output em formato de um vetor de character. Deve ser usada em conjunto com a função textOutput().

Exercício

  • Crie um aplicativo shiny que mostre os seguintes inputs: NOME (texto), IDADE (numérico) e SEXO (radio button).

Após coletar estas informações no ui, use-as para montar as seguintes frases no server e mostrá-las também no ui:

  • se sexo masculino: “Querido NOME, daqui a 2 anos você terá IDADE anos de idade”.
  • se sexo feminino: “Querida NOME, daqui a 2 anos você terá IDADE anos de idade”.

Projetos

  • shiny (ISP)
  • shiny (Form)
  • flexdashboard + shiny (Dengue)

th1460.github.io